Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11pk.mac < prev next >

Wrap

Text File | 1989-06-12 | 34.9 KB | 1,371 lines

.title $runjob run a job on a psuedo for RSTS/E .ident /8.0.05/ .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .include /SY:[1,2]COMMON.MAC/ .title $runjo .psect $code ; Brian Nelson ; Computer Services ; University of Toledo ; 2801 West Bancroft ; Toledo, Ohio 43606 ; (419) 537-2511 ; ; ; E D I T H I S T O R Y ; ; date time edit who why ; ; 12-jun-80 0 BDN initial coding ; 01-dec-82 1 BDN expand arg list, add f4/bp2 entry points ; 20-Apr-83 13:40:31 2 BDN add disk logging for terminal output ; 09-May-83 14:38:57 3 BDN check for detaching via modem disconnect ; 31-May-83 15:27:40 4 BDN add code to check for spawning from a pk ; 11-Jul-83 15:02:16 5 BDN add code to check if version 8.0 and if ; so use the new uu.sys features ; 12-Jul-83 12:48:04 5 BDN fixed '$runjo' entry point up to work. ; ; ************************************** .sbttl entry points ; $RUNJOB ; ; start a job on a psuedo keyboard and run it ; ; ; entry points: ; ; $RUNJOB (for compatibilty with previous versions) ; ; parameters: ; ; 0(r5) = address of command string address block ; 2(r5) = job termination flag word ; 4(r5) = lowest channel number to use ; 6(r5) = elapsed time limit ; ; ; ; $$RUNJ (new format) ; ; parameters: ; ; 0(r5) = address of command string address block ; 2(r5) = job termination flag word ; 4(r5) = lowest channel number to use ; 6(r5) = elapsed time limit ; 10(r5) = binary of account to log into ; 12(r5) = input file address (zero if none) ; 14(r5) = output file address (zero if none) ; ; ; RUNJOB (fortran/bp2/f77 callable) ; ; parameters: ; ; @r5 = dec standard arg count (fortran/bp2) ; 2(r5) = address of command string address block ; @4(r5) = job termination flag word ; @6(r5) = lowest channel number to use ; @10(r5) = elapsed time limit ; @12(r5) = binary of account to log into (optional) ; 14(r5) = address of a file to read input from ; 16(r5) = address of a file to put output to ; ; ; See sample fortran source code below for usage. ; Note that the channel number to start with must be low ; enough to accomidate the optional disk file for output ; if used. Ie, if you pass '11' (decimal) as the starting ; lun then channels 12, 13 and 14 must also be free for ; use. .sbttl explanation of the second arguement ; for the parameter at 2(r5), ( @4(r5) for Fortran/Bp2 ) ; which is the termination flag: ; ; if 2(r5) and 1 <> 0, exit on user typing a control D (^D) ; if 2(r5) and 2 <> 0, exit on control c (KMON) wait ; if 2(r5) and 4 <> 0, exit on end of commands (addr=0) ; if 2(r5) and 10<> 0, do not echo psuedo KB's output. ; if 2(r5) and 20<> 0, do not use binary mode ; if 2(r5) and 40<> 0, the ppn passed is real ; if 2(r5) and 100<>0, kill job if it logs out and return ; if 2(r5) and 200<>0, do not allow caller to be on a pk ; if 2(r5) < 0 , ignore errors (first char '?') ; ; error return: ; ; r0 = 0 no errors ; r0 > 0 r0 will have the RSTS error number in it ; r0 = -1 '?' found in first char of pk output line ; r0 = -2 PK job already running (calling job is on PK:) ; r0 = -3 elapsed time exceeded ; ; ; command address block format: ; ; example: ; ; ; run thru the 3 ccl commands ; ; exit on end of commands ('0' at end of cmdblk:) ; ; use rsts channel number 11 and 12 (decimal) ; ; no time limit ; ; cmdblk: .word 10$,20$,30$,0 ; 10$: .asciz #PIP DB1:/L:S#<cr><lf> ; 20$: .asciz #FOR JUNK=JUNK#<cr><lf> ; 30$: .asciz #SY/N#<cr><lf> ; .even ; ; calls $runjob ,<#cmdblk,#4,#11.,#0> ; tst r0 ; ; ; stack usage requirement: ; ; all internal vars and buffers need 170 decimal bytes ; of stack available ; ; internal register usage: ; ; r0 scratch, error return, single parameter passing ; r1 scratch, never saved on call/exit ; r2 address of next .asciz command ; r3 --> FIRQB+0 always ; r4 --> local data block (which is on the stack) ; r5 --> XRB+0 always ; .sbttl local data definitions .dsabl gbl .iif ndf ,edrt ,edrt = 0 .if ne ,edrt ; .priv is a null macro .ift ; for ted .macro .priv ; .endm .iff .globl .priv .endc ; for ted .macro $sleep t mov t ,xrb+0 .priv .sleep .endm $sleep .macro .print a,l ; perhaps minitab is here .if b, l ; or we are using this from .ift ; fortran or bp2 clr -(sp) ; no length, assume .asciz .iff ; length passed mov l ,-(sp) ; stuff it please .endc ; if b, len mov a ,-(sp) ; stuff string address call lprint ; and do it .endm .macro callr0 name ,arg mov arg ,r0 call name .endm callr0 nodevc = 6 notavl = 10 eof = 13 daterr = 15 detkey = 33 corcom = 460 .asect ; define offsets from r4 for local vars . = 0 ; offsets start at zerp buflen = 150. ; size of the pk buffer buffer: .blkb buflen ; the pk buffer, at 0(r4) rcount: .blkw ; size of last kb or pk read kbddb: .blkw ; address controlling job's ddb for KB: pkddb: .blkw ; address of the pk's ddb pkjob2: .blkw ; job number times two for the pk job pkkbn: .blkw ; kb number of the PK: in use urts: .blkw 2 ; the controlling job's default RTS uppn: .blkw ; the controlling job's PPN upriv: .blkw ; <> 0 if controlling job is in (1,*) ujob2: .blkw ; the controlling job's job number * 2 cmds: .blkw ; copy of command block address abortf: .blkw ; copy of the termination flag pklun2: .blkw ; channel number times two for PK kblun2: .blkw ; channel number times two for KB timout: .blkw ; copy of elapsed time flag newppn: .blkw ; if switching ppn's inf: .blkw ; input file if given inbfa: .blkw ; input file buffer address outf: .blkw ; output file if given outbfa: .blkw ; output file buffer address influn: .blkw ; disk input file lun * 2 outflu: .blkw ; disk output file lun * 2 infpnt: .blkw ; disk input buffer pointer outfpn: .blkw ; disk output buffer pointer timini: .blkw ; initial time at entry here. cyc: .blkw lastch: .blkw ; last char of preceeding pk read kbintf: .blkw ; interface type for controlling job js.kb = 2 ; bit in JBWAIT for KB wait state .if ne ,edrt .ift stim = 1 .iff stim = 3 ; sleep time in main loop .endc swait = < << 60./stim >+1 > * stim> / 2 .iif le ,swait ,swait = 1 locsiz = . + 2 ; size of the local data .assume buffer eq 0 .psect $code ; bits defined in abortf(r4) f$ctld = 1 f$kmon = 2 f$eot = 4 f$nech = 10 f$nbin = 20 f$nppn = 40 f$nopr = 100 f$nopk = 200 str.cr: .byte 0,0 plogin: .rad50 /LOGIN / .word -1 crfail: .asciz /?Can't start job/<cr><lf> nopk: .asciz /?no PK's/ <cr> <lf> fatbug: .asciz /?bug in openpk/ <cr> <lf> .even .sbttl fortran/bp2 entry point .if eq ,edrt .ift ; byte filnam(30) ; byte out(512) ; integer outf(2) ; byte buffer(84) ; outf(2) = iaddr(out) ; outf(1) = iaddr(filnam) ; read (5,1) filnam ; 1 format (30a1) ; filnam(30) = 0 ; type *,'starting' ; 5 continue ; read (5,100) (buffer(i),i=1,80) ; mode = 5 ; do 10 j = 80,1,-1 ; if (buffer(j).ne.' ') go to 20 ; 10 continue ; mode = "100001 ; buffer(1) = 0 ; go to 30 ; 20 continue ; buffer(j+1) = 13 ; buffer(j+2) = 10 ; buffer(j+3) = 0 ; 30 continue ; ierr = runjob(buffer,mode,11,0,0,,outf) ; type *,ierr ; goto 5 ; 100 format (80a1) ; stop ; end ; ; ; Note: the 'infile' (not yet implemented) and the 'outfile' address ; actually are parameter blocks consisting of ; ; (1) a filename address ; (2) a buffer address of 1000 (8) bytes ; ; as in: ; ; integer outf(2) ; byte outbuf(512) ; byte outnam(30) ; read (5,100) outnam ; outnam(30) = 0 ; outf(1) = iaddr(outnam) ; outf(2) = iaddr(outbuf) .sbttl calling example from MINITAB's 'system' command ; subroutine syscmd(cmdlin) ; c ; c change 'cmdlin' to byte for version 82 of minitab ; c ; byte cmdlin(80) ; byte buffer(84) ; common /isc/ buffer ; integer runjob ; c ; integer irsts,irsxts,irsx,ivax,irt11,myexec,pkflag ; common /ostype/ irsts,irsxts,irsx,ivax,irt11,myexec,pkflag ; c ; if ((myexec.eq.irsts).or.(myexec.eq.irsxts)) go to 5 ; write (5,220) ; return ; c ; 5 continue ; do 10 j = 1 , 80 ; buffer(j) = ' ' ; 10 continue ; c ; do 20 j = 1 , 80 ; if (cmdlin(j).eq.' ') go to 30 ; 20 continue ; j = 0 ; 30 continue ; k = j + 1 ; i = 1 ; c ; do 40 j = k,80 ; buffer(i) = cmdlin(j) ; i = i + 1 ; 40 continue ; c ; mode = 5 ; do 80 j = 80,1,-1 ; if (buffer(j).ne.' ') go to 90 ; 80 continue ; mode = "100001 ; buffer(1) = 0 ; write (5,200) ; go to 100 ; 90 continue ; buffer(j+1) = 13 ; buffer(j+2) = 0 ; 100 continue ; mode = mode .or. "100 ; ierr = runjob(buffer,mode,11,0) ; if (ierr.ne.0) write (5,210) ierr ; return ; c ; c ; 200 format (' Type control D (^D) to return to MINITAB'/) ; 210 format (' PK driver returned error code ',i5) ; 220 format (' %Minitab-W The SYSTEM command is not available') ; c ; end .sbttl fortran/bp2 entry point continued .psect $code f4.out = 16 ; optional output fileblock f4.inf = 14 ; optional input fileblock f4.ppn = 12 ; optional ppn to log into f4.tim = 10 ; timeout flag f4.lun = 6 ; lowest channel number to use f4.fla = 4 ; run flags f4.buf = 2 ; command clock address runjob::mov r5 ,-(sp) ; convert f4/bp2 call format mov r4 ,-(sp) clr -(sp) ; assume no address for outfile cmpb @r5 ,#7 ; 7 args (last is output file) blo 1$ ; no cmp f4.out(r5),#-1 ; yes, is the arguement ommitted? beq 1$ ; yes. leave a zero for the address mov f4.out(r5),@sp ; no, copy the filename address 1$: clr -(sp) ; assume no address for infile cmpb @r5 ,#6 ; 6 args (second to last) blo 2$ ; no cmp f4.inf(r5),#-1 ; yes, at least 6. was it ommitted? beq 2$ ; yes, address of 177777 is dec's way mov f4.inf(r5),@sp ; no, copy the address to the stack 2$: clr -(sp) ; assume no new ppn now cmpb @r5 ,#5 ; passed another ppn to use? blo 5$ ; no cmp f4.ppn(r5),#-1 ; at least 5 parameters, is it real? beq 5$ ; yep mov @f4.ppn(r5),@sp ; yes, stuff it please 5$: mov @f4.tim(r5),-(sp) ; to that expected by the pk mov @f4.lun(r5),-(sp) ; driver here mov @f4.fla(r5),-(sp) ; job termination flag clr -(sp) ; for now, no cmd blocks mov sp ,r4 ; point to new parameter list clr -(sp) ; create cmd block descriptor mov f4.buf(r5),-(sp) ; buffer address mov sp ,4(sp) ; stuff the block in now mov r4 ,r5 ; saved address of new param tstb @(sp) ; null command line passed? bne 10$ ; no clr (sp) ; yes, setup for nothing then 10$: call $$runj ; do the work and exit add #22 ,sp ; pop parameters mov (sp)+ ,r4 ; pop saved r4 mov (sp)+ ,r5 ; pop saved r5 return ; and exit 100$: .asciz /starting - / 110$: .byte cr,lf .even .endc ; not included for ted .sbttl main control loop .psect $code $runjo::clr -(sp) clr -(sp) clr -(sp) mov 6(r5) ,-(sp) mov 4(r5) ,-(sp) mov 2(r5) ,-(sp) mov @r5 ,-(sp) mov sp ,r5 call $$runj add #7*2 ,sp return $$runj: mov #jfsys ,xrb+0 ; get privs back if possible .priv ; prefix, if required. .set ; set keyword bit call to exec save <r1,r2,r3,r4,r5> ; should do this. sub #locsiz ,sp ; allocate space for us. mov sp ,r4 ; r4 will point to work area call init ; initial junk for startup bcs 100$ ; oops ! call openfi bcs 100$ ; oops ! call login ; login pk bcs 100$ ; oops call pkjobn ; get the pk job number * 2 call record ; record time-sharing session 100$: die: call clsout add #locsiz ,sp ; pop our work area from stack mov #firqb+fqfil,r3 ; useful address call $zapfqb movb #clsfq ,firqb+fqfun ; close the channels we used movb pklun2(r4),@r3 ; channels here .priv ; prefix as usual calfip call $zapfqb movb #clsfq ,firqb+fqfun ; close the channels we used movb kblun2(r4),@r3 ; channels here .priv ; prefix as usual calfip unsave <r5,r4,r3,r2,r1> mov #jfsys ,xrb+0 ; drop privs at exit .priv ; .clear ; drop bits in keyword call return .sbttl initial stuff .assume uppn eq <urts+4> .assume upriv eq <uppn+2> .assume ujob2 eq <upriv+2> .assume cmds eq <ujob2+2> .assume abortf eq <cmds +2> .assume pklun2 eq <abortf+2> .assume kblun2 eq <pklun2+2> .assume timout eq <kblun2+2> .assume newppn eq <timout+2> .assume inf eq <newppn+2> .assume inbfa eq <inf+2> .assume outf eq <inbfa+2> .assume outbfa eq <outf+2> .assume influn eq <outbfa+2> .assume outflu eq <influn+2> init: call $zapfqb ; zap the firqb first please mov r4 ,r1 ; clear out the local vars mov #locsiz-2,r0 ; which we allocated on the 5$: clrb (r1)+ ; stack sob r0 ,5$ ; all of it please movb #uu.sys ,firqb+fqfun ; systat sys call with subfun .priv ; zero to get default user .uuo ; runtime system. mov firqb+12,timini(r4) ; save user's connect mov #swait ,cyc(r4) ; stuff control for time check mov r4 ,r3 ; Base address of impure area. add #urts ,r3 ; we will start here. mov firqb+30,(r3)+ ; copy two rad50 words for mov firqb+32,(r3)+ ; user's default rts mov firqb+26,(r3)+ ; and the ppn for our user. clr (r3)+ ; set the user is (1,*) flag cmpb #1 ,<uppn+1>(r4) ; perm privs here ? bne 10$ ; nop mov sp ,-2(r3) ; yes, set a flag then 10$: movb firqb+fqjob,(r3)+ ; job number times 2 clrb (r3)+ ; to be sure, get high byte out mov (r5)+ ,(r3)+ ; save command string address mov (r5)+ ,(r3)+ ; save the abort flag mov (r5)+ ,r0 ; starting lun to use for the ble 100$ ; pk and for the kb. Must be asl r0 ; > 0 mov r0 ,(r3)+ ; pk lun is the first one add #2 ,r0 ; kblun2 = pklun2 + 2 mov r0 ,(r3)+ ; thats all mov (r5)+ ,(r3)+ ; job elapsed time parameter. mov (r5)+ ,(r3)+ ; alternate ppn bit #f$nppn ,abortf(r4) ; really do this bne 20$ ; yes clr -2(r3) ; no 20$: mov (r5)+ ,r0 ; get input file block beq 30$ ; a null parameter there mov 2(r0) ,inbfa(r4) ; save input buffer address mov @r0 ,r0 ; get filename address now. tstb @r0 ; anything there ? beq 30$ ; no, leave name address eq 0 mov r0 ,inf(r4) ; yes, save address mov kblun2(r4),influn(r4) ; also allocate a channel add #2 ,influn(r4) 30$: mov (r5)+ ,r0 ; get output file block beq 40$ ; a null parameter there mov 2(r0) ,outbfa(r4) ; save output buffer address mov @r0 ,r0 ; get filename address now. tstb @r0 ; anything there ? beq 40$ ; no, leave name address eq 0 mov r0 ,outf(r4) ; yes, save address mov kblun2(r4),outflu(r4) ; also allocate a channel add #4 ,outflu(r4) 40$: 100$: clr r0 mov #520. ,xrb+0 ; get the controlling job's .priv ; kbddb as: .peek ; peek(peek(peek(520.))) .priv ; and again .peek ; ..... .priv ; one more time .peek ; ah ! mov xrb+0 ,kbddb(r4) ; and pack it away mov #firqb ,r3 ; r3 will always --> IOSTS mov #xrb ,r5 ; r5 will always --> xrb+0 call $zapfqb ; clear firqb for getting interface movb #uu.trm ,firqb+fqfun ; type. perhaps caller will not movb #377 ,firqb+5 ; allow a pk to run a pk job. .priv ; rt emulator perhaps? .uuo ; get terminal characteristics movb firqb+24,kbintf(r4) ; save the interface type bit #f$nopk ,abortf(r4) ; allow caller to be on a pk? beq 110$ ; yes cmpb kbintf(r4),#10 ; no, is the caller running on bne 110$ ; a psuedo keyboard already? mov #-2 ,r0 ; yes sec ; also set this error status br 120$ ; and exit 110$: clc ; and away we go ! 120$: return ; for now. .sbttl open files up please openfi: call openkb ; open 'kb:' mode 1 bcs 100$ ; oops ! call openpk ; open 'pk?:' bcs 100$ callr0 getddb ,pkkbn(r4) ; we will need the pk's DDB. bcs 100$ ; oops mov r0 ,pkddb(r4) ; and save the kbddb call opninp bcs 100$ call opnout 100$: return .sbttl open/close logging file if open .if eq ,edrt ; save address space for TED .ift opnout: call $zapfqb ; open possible optional output mov outf(r4),r2 ; get output filename beq 100$ ; nothing to open mov r2 ,r1 ; save it 10$: tstb (r1)+ ; get the length please bne 10$ ; no nulls as of yet sub r2 ,r1 ; length + 1 dec r1 ; length mov #xrb ,r0 ; clear firqb for a .fss mov r1 ,(r0)+ ; xrb.xrlen := len(filename) mov r1 ,(r0)+ ; xrb.xrbc := len(filename) mov r2 ,(r0)+ ; xrb.xrloc := address(filename) .rept 4 ; the rest is unused clr (r0)+ ; .endr ; .priv ; now do the filename string scan .fss ; simple movb @r3 ,r0 ; get error codes (r3 --> firqb+0) bne 110$ ; oops movb #crefq ,firqb+fqfun ; open a file function for fip movb outflu(r4),firqb+fqfil ; channel number times 2 clr firqb+fqmode ; no modes please .priv calfip ; get rsts to open it up movb @r3 ,r0 ; copy error codes from firqb+0 bne 110$ ; ok clr outfpnt(r4) ; init output buffer pointer mov outbfa(r4),r0 ; null fill the output buffer mov #1000 ,r1 ; 1000 (8) bytes worth 50$: clrb (r0)+ ; clear a byte sob r1 ,50$ ; and back for more 100$: clc ; no errors return 110$: clr outf(r4) ; clear filename address out movb firqb ,r0 sec ; error exit, error code in r0 return clsout: tst outf(r4) ; output file there ? beq 100$ ; no call wrtout ; dump output buffer call $zapfqb ; and close the file movb #clsfq ,firqb+fqfun ; fip function to close it movb outflu(r4),firqb+fqfil ; channel number times 2 .priv ; rt11.rts prefixes today ? calfip ; close it 100$: return .iff ; for TED, dummy fileopens out opnout: clsout: clc return .endc ; if eq, edrt .sbttl open input file (not yet implemented) opninp: clr inf(r4) return .sbttl openkb - open 'kb:' as file 1, mode 1 openkb: call $zapfqb ; zap firqb movb kblun2(r4),@#firqb+fqfil ; channel 1 mov #"KB,@#firqb+fqdev ; 'kb:' mov #buflen,@#firqb+fqbufl ; buffer length mov #100001!40!20,@#firqb+fqmode ; mode 1+32+16 ;; bis #100000,@#firqb+fqmode ; mode is real movb #opnfq,@#firqb+fqfun ; open function .priv ; have rsts/e calfip ; open the file tstb @r3 ; any problems ? beq 10$ ; no, go return movb @r3 ,r0 sec 10$: return ; back to work... .sbttl get job number for PK job pkjobn: mov pkddb(r4),@r5 ; get the pk ddb and then we add #2 ,@r5 ; can get the job number out .priv ; ddjbno by a quick peek. .peek ; peek at it mov @r5 ,-(sp) ; save it for a moment bic #^C126. ,(sp) ; junk high order stuff and mov (sp)+ ,pkjob2(r4) ; save it return getddb: call $zapfqb ; get ddb of kb number passed movb #uu.tb2 ,firqb+fqfun ; in r0. Get DEVOKB to get the .priv ; disk count thus getting the .uuo ; eventually the kb ddb's. mov firqb+12,-(sp) ; save this for a moment. movb #uu.tb1 ,firqb+fqfun ; get tables part 1 for the .priv ; devptr .uuo ; rsts does it again ! mov firqb+10,@r5 ; @r5 := devptr add (sp)+ ,@r5 ; plus devokb .priv ; now get devtbl as .peek ; peek( devtbl+edvokb ) mov r0 ,-(sp) ; add in the kbnumber times 2 asl (sp) ; to get the ddb of the tty. add (sp)+ ,@r5 ; all set now. .priv ; prefix if needed. .peek ; and peek at it. mov @r5 ,r0 ; return kbddb in r0. clc ; no errors return ccstate:call $zapfqb ; see if job is in KB ^C wait movb #uu.sys ,firqb+fqfun ; do a job systat part 2 incb firqb+5 ; movb pkjob2(r4),firqb+4 ; where the job number goes asrb firqb+4 ; not times two for .uuo .priv ; of course .uuo ; get rsts cmp firqb+14,#js.kb ; jbwait show a kb wait ? clc ; restore possible c bit set bne 10$ ; no, time to leave now. mov firqb+32,@r5 ; stuff JDB address for a peek add #6 ,@r5 ; we need address of jdwork .priv ; of course .peek ; sneak a look at the exec add #10. ,@r5 ; finally where to look at in .priv ; the job's work block. .peek ; and so on ....... tst @r5 ; < 0 bpl 10$ ; no, exit with no wait sec ; yes, flag as ^C(0) wait. 10$: return .sbttl check out the pk's status ttyou: mov r0 ,@r5 ; see if pk is doing tt output add #10. ,@r5 ; check buffer chains .priv ; you know .peek ; only a privledged few can do mov @r5 ,-(sp) ; this, you know. mov r0 ,@r5 ; one more time please add #12. ,@r5 ; and so on .priv ; .peek ; and get the peeker cmp (sp)+ ,@r5 ; empty yet ? bne 10$ ; no clc ; yes return 10$: sec return ; note: following code from ATPK (with minor mods) pksts: save <r0,r1> call pkjobn ; get the job number for PKn: clr r0 ; are we the same job number ? mov pkjob2(r4),r1 ; save it here cmpb r1 ,ujob2(r4) ; if so, then login is not done bne 10$ ; ok com r0 ; no, we are the same job. 10$: tstb r1 ; a real job there yet ? beq 20$ ; no call $zapfqb ; yes, get the job's ppn movb #uu.sys ,firqb+fqfun ; use the uu.sys instead of movb r1 ,firqb+4 ; of a bunch of peeking at asrb firqb+4 ; rsts. .priv ; you know .uuo ; get job stats function 0 mov firqb+26,r1 ; and stuff ppn into r1. 20$: tst upriv(r4) ; running in (1,*) ? bne 30$ ; yes, status is ok for now tst r1 ; try ppn (or jobnun times 2) bne 30$ ; real ppn or job number mov #-2 ,r0 ; set bad status up 30$: tst r0 ; bad status by now ? bne 100$ ; yes, time to go for now. call $zapxrb ; ok so far, is the PK in a mov #str.cr ,xrb+xrloc ; condition to accept stuff inc xrb+xrlen ; buffer size of 1 inc xrb+xrbc ; same thing goes here movb pklun2(r4),xrb+xrci ; channel number times 2 mov #6 ,xrb+xrmod ; basic+ 'record' modifier if kb .priv ; once again .write ; finally ! movb @r3 ,r0 ; errors ? 100$: tst r0 ; errors ? beq 110$ sec ; tst does a clc,'mov' leaves it 110$: unsave <r1,r0> ; pop regs, retain status and return ; exit .sbttl openpk - open 'pk?:' as file 2 openpk: mov #-1,r1 ; init pk at -1 10$: inc r1 ; next pk call $zapfqb ; clean firqb movb pklun2(r4),@#firqb+fqfil ; channel 2 mov #buflen,@#firqb+fqbufl ; buffer length mov #"PK,@#firqb+fqdev ; 'pk?:' movb r1,@#firqb+fqdevn ; pk number movb #-1,@#firqb+fqdevn+1 ; unit is real movb #opnfq,@#firqb+fqfun ; open function .priv ; have rsts calfip ; open the pk movb @r3 ,r0 ; any problems? beq 30$ ; no, go return cmpb #notavl,@r3 ; not available ? beq 10$ ; yes, try for another cmpb #nodevc,@r3 ; not valid device ? bne 50$ ; unknown RSTS error happened .print #nopk br 50$ ; bye 30$: call $zapfqb ; zap firqb movb #uu.fcb,@#firqb+fqfun ; fcb function movb pklun2(r4),@#firqb+fqfil ; channel 2 asrb firqb+fqfil ; not times two here .priv ; have rsts .uuo ; return fcb info movb @r3 ,r0 ; any problems ? bne 40$ ; yes, fatal movb @#firqb+fqext,r1 ; kb * 2 asrb r1 ; pk's kb#: movb r1 ,pkkbn(r4) ; save it call $zapfqb ; zap firqb again movb #uu.trm,@#firqb+fqfun ; ttyset function mov #-1,@#firqb+fqfil ; list attributes .priv ; have rsts .uuo ; return ttyset info movb @r3 ,r0 ; any problems ? bne 40$ ; yes, fatal movb #uu.trm,@#firqb+fqfun ; ttyset function movb #-1,@#firqb+fqfil ; chr$(255%) movb r1,@#firqb+fqfil+1 ; pk device .priv ; have rsts .uuo ; do a ttyset movb @r3 ,r0 ; any problems ? bne 40$ ; yes, fatal clc return ; back to work... 40$: call errmsg ; say the error .print #fatbug ; say we have internal error 50$: sec return .sbttl log the job in .iif ndf, uu.tb3,uu.tb3 = -29. $pklog:: login: call $zapfqb ; clear out the firqb to set movb #uu.tb3 ,firqb+fqfun ; do a uu.tb3 to see if the field .priv ; for UNTLVL is zero or real. if .uuo ; real then we haev version 8.0 tst firqb+12 ; if version 8 then we will try beq 10$ ; the new uu.job format call logv8 ; version 8.0 bcc 100$ ; it worked 10$: call logv7 ; either version 7 or new call failed 100$: return logv8: call $zapfqb ; version 8, enter a run time system mov #firqb+fqfun,r0 ; at the p.new entry point movb #uu.job ,(r0)+ ; create a job function for fip movb #20!100!200,(r0)+ ; create logged in @ defkbm always movb pkkbn(r4),(r0)+ ; kb number to attach to job clr (r0)+ ; unused field mov <urts+0>(r4),(r0)+ ; user's default run time system mov <urts+2>(r4),(r0)+ ; both rad50 words please clr (r0)+ ; unused field mov newppn(r4),@r0 ; try for the passed ppn beq 10$ ; nothing cmpb #1 ,uppn+1(r4) ; is our caller perm priv? beq 20$ ; yes cmpb #1 ,newppn+1(r4) ; no, is the caller trying bne 20$ ; for a priv account ? 10$: mov uppn(r4),@r0 ; ppn to login job into. 20$: bisb #40 ,firqb+4 ; set flag for account to login to movb corcom ,-(sp) ; save this please clrb corcom ; core common is also passed .priv ; get set to do it now .uuo ; try to create the job now movb (sp)+ ,corcom ; restore first byte of core common movb firqb ,r0 ; did it work? bne 110$ ; no clc ; yes, flag success and exit return ; bye 110$: sec ; job creation failed, exit return ; set a flag and return logv7: call $zapfqb mov #firqb+fqfun,r0 ; up the spawn of LOGIN. movb #uu.job ,(r0)+ ; create a job call to .uuo movb #128. ,(r0)+ ; create if logins disabled. clrb (r0)+ ; must be zero (?) mov #402 ,(r0)+ ; the project programmer (1,2). mov plogin ,(r0)+ ; first part of program to run mov plogin+2,(r0)+ ; which is normally $LOGIN.* mov plogin+4,(r0)+ ; extension clr (r0)+ ; skip next (paramter data) mov <urts+0>(r4),(r0)+ ; the new job's default run time mov <urts+2>(r4),(r0)+ ; system (usaully BAS4F ! BASIC) mov newppn(r4),@r0 ; try for the passed ppn beq 10$ ; nothing cmpb #1 ,uppn+1(r4) ; is our caller perm priv? beq 15$ ; yes cmpb #1 ,newppn+1(r4) ; no, is the caller trying bne 15$ ; for a priv account ? 10$: mov uppn(r4),@r0 ; ppn to login job into. 15$: tst (r0)+ ; fix firqb pointer movb pkkbn(r4),(r0)+ ; kb number for the job. mov #29000. ,firqb+34 ; paramter word .priv ; prefix ? .uuo ; create the job please movb @r3 ,r0 ; errors ??? bne 100$ ; yes, we will die then $sleep #1 mov #20. ,r1 ; loop count for login wait 20$: call pksts ; pk is ready yet ? bcc 30$ ; yep $sleep #1 ; no keep trying for a while sob r1 ,20$ ; ok ? .print #crfail ; die br 110$ 30$: clr r0 return 100$: call errmsg ; print the error and die 110$: sec ; set return code return .sbttl record - record the session record: mov cmds(r4),r2 call $zapfqb ; close the kb up for a moment. movb #clsfq ,firqb+fqfun ; calfip function to close a movb kblun2(r4),firqb+fqfil ; file. .priv ; as usual calfip ; thats all there is to it. call openkb ; open it mode 1 10$: bit #f$nopr ,abortf(r4) ; kill on logout? beq 15$ ; no mov pkddb(r4),xrb+0 ; get ddb address add #2 ,xrb+0 ; need to look at the jobnumber .priv ; times 2 .peek ; if no job number then the tstb xrb+0 ; pk has logged out beq 60$ ; if so, abort and return 15$: call getkb ; get kb data cmp #1,rcount(r4) ; recount = 1 bne 20$ ; no, continue movb @r4,r0 ; take first byte bicb #200,r0 ; trim parity cmpb r0,#'D-100 ; is it term character ? bne 20$ ; yes, go return bit #f$ctld ,abortf(r4) ; really exit on control D ? bne 60$ ; yep 20$: cmpb #daterr,@r3 ; nothing there ? beq 30$ ; yes, try pk cmpb #detkey ,@r3 ; controling job detach ? beq 60$ ; no callr0 putpk ,r4 ; put out to the pk br 35$ 30$: call pksts ; Is the job ready for a bcs 35$ ; a command yet ? callr0 ttyou ,pkddb(r4) ; currently printing on PK: bcs 35$ ; yep callr0 ttyou ,kbddb(r4) ; check tty out bcs 35$ ; TTY is still busy then tst (r2) ; next command ? beq 31$ ; all done folks call docmd ; do a command br 35$ 31$: call jstop ; End of comamnds, see if we bcs 60$ ; should quit now. 35$: call getpk ; get pk data cmpb #eof,@r3 ; pk say anything ? bne 40$ ; yes, continue $sleep #stim ; take a quick nap here br 55$ ; and try later 40$: call errchk ; scan for a '?' as first char bcc 50$ ; no, all is well tst abortf(r4) ; keep going on error (<0) ? bmi 50$ ; yep call putkb ; a problem, print error out call putout mov #-1 ,r0 ; and exit br 70$ 50$: call putkb ; tell the kb call putout 55$: call timchk ; job elapsed time run out yet? bcs 70$ ; yep, so exit now. br 10$ 60$: clr r0 ; a normal exit 70$: return .sbttl stop check for termination yet jstop: bit #f$eot ,abortf(r4) ; stop on end of the command bne 100$ ; yes, bye bit #f$kmon ,abortf(r4) ; stop on control c wait(0) beq 90$ ; no call ccstate ; check for ^C state bcs 100$ ; exit if cc wait 90$: clc return 100$: sec return docmd: mov @r2 ,r0 ; compute command line length 10$: tstb (r0)+ ; end of .asciz string ? bne 10$ ; no sub @r2 ,r0 ; yes, get length now dec r0 ; off by one mov r0 ,rcount(r4) ; put it there for putpk callr0 putpk ,(r2)+ ; and do it 100$: return .if eq ,edrt ; normal mode .ift timchk: dec cyc(r4) ; check job time yet ? bgt 100$ ; no, just exit. mov #swait ,cyc(r4) ; check, so reset cycle count. tst timout(r4) ; but should we check at all ? ble 100$ ; no, so just exit. ;- call $zapfqb ; clear out firqb for uu.sys ;- movb #uu.sys ,firqb+fqfun ; set uuo function (job systat) ;- movb pkjob2(r4),firqb+fqfun+1; insert job number here ;- asrb firqb+fqfun+1 ; not times two please. ;- .priv ; just in case (is global sym) ;- .uuo ; get job stats back in firqb ;- sub timini(r4),firqb+12 ; get total time controlling pk ;- cmp firqb+12,timout(r4) ; time to abort job yet ? .priv ; the pk job stats only seem to .time ; get updated whenever there is sub timini(r4),xrb+2 ; some activity on the job's pk cmp xrb+2 ,timout(r4) ; so use controlling jobs time. blt 100$ ; If lt, do not kill pkjob yet. mov #-3 ,r0 ; set return status code. sec ; yes, also set carry. Now exit return ; for job time exceeded. 100$: clc return .iff ; skip this for inclusion into ; ted. timchk: clc ; return all is well for TED. return .endc ; .if eq, edrt .sbttl getkb - get data from kb getkb: call $zapxrb ; clean xrb mov #buflen,@#xrb+xrlen ; buffer length mov r4,@#xrb+xrloc ; buffer location movb kblun2(r4),@#xrb+xrci ; channel 1 mov #8192.,@#xrb+xrmod ; record 8192% .priv ; have rsts .read ; read from kb mov @#xrb+xrbc,rcount(r4) ; save rcount return ; back to work... .sbttl putkb - put data to kb putkb: call $zapxrb ; clean xrb mov #buflen,@#xrb+xrlen ; buffer length mov r4,@#xrb+xrloc ; buffer location mov rcount(r4),@#xrb+xrbc ; byte count movb kblun2(r4),@#xrb+xrci ; channel 1 mov #1,@#xrb+xrmod ; record 1% .priv ; have rsts .write ; write on kb return ; back to work... .sbttl getpk - get data from pk getpk: call $zapxrb ; clean zrb mov #buflen,@#xrb+xrlen ; buffer length mov r4,@#xrb+xrloc ; buffer location movb pklun2(r4),@#xrb+xrci ; channel 2 .priv ; have rsts .read ; read from pk mov @#xrb+xrbc,rcount(r4) ; save rcount beq 100$ ; nothing there movb <lastch+1>(r4),lastch(r4);shuffle last char from prev mov rcount(r4),-(sp) ; read and store the last char add r4 ,(sp) ; from this read in there. dec (sp) movb @(sp)+ ,<lastch+1>(r4) ; finally ! 100$: return ; back to work... .sbttl putpk - put data to pk putpk: call $zapxrb ; clean xrb mov #buflen,@#xrb+xrlen ; buffer length mov r0,@#xrb+xrloc ; buffer location mov rcount(r4),@#xrb+xrbc ; byte count movb pklun2(r4),@#xrb+xrci ; channel 2 mov #9.,@#xrb+xrmod ; record 9% .priv ; have rsts .write ; write to pk return ; back to work... .sbttl write to optional disk log .if eq ,edrt ; save address space for ted .ift putout: save <r0,r1,r2> tst outf(r4) ; a file open beq 100$ ; no, just exit then mov rcount(r4),r0 ; number of bytes to put out beq 100$ ; nothing to do if zero mov r4 ,r2 ; string to put into buffer 10$: mov outbfa(r4),r1 ; address of the output buffer cmp outfpnt(r4),#1000 ; buffer full yet ? blo 30$ ; no call wrtout ; yes, dump buffer out to disk clr outfpnt(r4) ; and init the buffer pointer save <r0,r1> ; now clear the buffer out mov #1000 ,r0 ; 1000 bytes to clear 20$: clrb (r1)+ ; r1 already had the buffer addres sob r0 ,20$ ; next byte please unsave <r1,r0> ; pop these back 30$: add outfpnt(r4),r1 ; point to next free byte in buffer movb (r2)+ ,@r1 ; next byte please inc outfpnt(r4) ; get set for next byte sob r0 ,10$ ; next please 100$: unsave <r2,r1,r0> return wrtout: save <r0> call $zapxrb mov #xrb ,r0 ; pointer to xrb mov #1000 ,(r0)+ ; xrb.xrlen := 1000 (8) mov #1000 ,(r0)+ ; xrb.xrbc := 1000 mov outbfa(r4),(r0)+ ; xrb.xrloc := buffer_address movb outflu(r4),@r0 ; channel number times 2 .priv ; rt11.rts prefix needed? .write ; simple unsave <r0> return .iff ; if edrt <> 1 then dummy call putout: wrtout: return .endc ; if eq, edrt .sbttl error checking on the PK .if eq ,edrt ; leave out for ted, else in .ift ; not ted errchk: save <r0,r1,r2> mov r4 ,r2 ; address of text to check mov rcount(r4),r1 ; initial length 10$: clr r0 ; position in the string mov r2 ,-(sp) ; replace instr call please mov r1 ,-(sp) ; save pointer and length ble 25$ ; no text in the string ? 20$: inc r0 ; pos := succ(pos) cmpb (r2)+ ,#'? ; find a possible error msg? beq 25$ ; perhaps sob r1 ,20$ ; no, try the next one clr r0 ; no match, set position to 0 25$: mov (sp)+ ,r1 mov (sp)+ ,r2 cmp r0 ,#1 ; by a line terminator like blt 100$ ; a cr,lf or ff. bgt 30$ ; Not at start of the line cmp r2 ,r4 ; at the start of the record? bne 30$ ; no, nothing special to do. cmpb lastch(r4),#cr ; Was first char of record, look bhi 40$ ; at the last char of prev rec. br 110$ ; fatal error, exit with 'c' 30$: mov r2 ,-(sp) ; Check preceeding char for add r0 ,(sp) ; a line terminator here. dec (sp) ; peek at the previous char dec (sp) ; peek at the previous char cmpb @(sp)+ ,#cr ; well ? blos 110$ ; bye 40$: add r0 ,r2 ; No error, skip past the '?' sub r0 ,r1 ; and adjust the line length. bgt 10$ ; and try once again 100$: clc ; no error, exit ok br 120$ ; pop registers and leave. 110$: sec 120$: unsave <r2,r1,r0> return 200$: .asciz /?/ .iff ; for ted, save the space errchk: clc ; no error return ; and exit .endc errmsg: movb firqb ,firqb+4 ; pass error number to fip movb #errfq ,firqb+fqfun ; fip function .priv ; rt emu perhaps ? calfip ; simple to do clrb firqb+37 ; insure .asciz please .print #firqb+4 ; print the .asciz string return .sbttl zero firqb out .if eq ,edrt ; if not in TED, include this .ift $zapfqb: mov r0 ,-(sp) mov r1 ,-(sp) mov #firqb ,r1 mov #40/2 ,r0 1$: clr (r1)+ sob r0 ,1$ mov (sp)+ ,r1 mov (sp)+ ,r0 return .iff global <$zapfqb> .endc $zapxrb:mov r0 ,-(sp) mov #xrb ,r0 10$: clr (r0)+ cmp r0 ,#xrb+xrmod ble 10$ mov (sp)+ ,r0 return lprint: mov r0 ,-(sp) ; .asciz string printer. put mov 6(sp) ,r0 ; it here to avoid global refs bne 20$ ; a real length was passed mov 4(sp) ,r0 ; zero length, assume .asciz 10$: tstb (r0)+ ; and find the length of it bne 10$ ; no, keep going sub 4(sp) ,r0 ; subtract string address from dec r0 ; current pointer + 1. 20$: call $zapxrb ; clear xrb out mov 4(sp) ,xrb+xrloc ; stuff buffer address for RSTS mov r0 ,xrb+xrlen ; and the length twice mov r0 ,xrb+xrbc ; again .priv ; rt perhaps? emt 4 ; do a .write mov (sp)+ ,r0 ; pop the register we used mov (sp) ,4(sp) ; bubble return address up cmp (sp)+ ,(sp)+ ; pop parameter list at last return ; bye .end